home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / vsc92nov.zip / Primitive.c < prev    next >
C/C++ Source or Header  |  1992-11-02  |  2KB  |  94 lines
  1. /*
  2.  * Primitive.c -- Implementation of Scheme Primitives
  3.  *
  4.  * (C) m.b (Matthias Blume), Mar 1992, HUB/Ger
  5.  */
  6.  
  7. # ident "@(#)Primitive.c    (C) M.Blume, Humboldt-Uni Berlin, 1.2"
  8.  
  9. # include <stdio.h>
  10.  
  11. # include "storext.h"
  12. # include "Primitive.h"
  13. # include "identifier.h"
  14. # include "type.h"
  15. # include "except.h"
  16.  
  17. /*
  18.  * There is a file "builtins.tab", where each built-in function
  19.  * should be registered by means of an entry of the form
  20.  *      BUILTIN (name-of-function, name-of-cont-function, name-string)
  21.  */
  22.  
  23. # include "builtins.tab"
  24.  
  25. static
  26. ScmPrimitive primitive_array [] = {
  27.  
  28. # define BUILTIN_CONT(f,c,n,a) { ScmType (Primitive), f, c, 0, n, a },
  29. # define BUILTIN(f,n,a) { ScmType (Primitive), f, NULL, 0, n, a },
  30. # include "builtins.tab"
  31. # undef BUILTIN
  32. # undef BUILTIN_CONT
  33.  
  34. };
  35.  
  36. # define DIM(x) (sizeof x / sizeof x[0])
  37.  
  38. static
  39. void dump (void *vprim, FILE *file)
  40. {
  41.   dump_ul ((ScmPrimitive *)vprim - primitive_array, file);
  42. }
  43.  
  44. static
  45. void *restore_init (FILE *file)
  46. {
  47.   unsigned short num;
  48.  
  49.   num = restore_ul (file);
  50.   return (void *) (primitive_array + num);
  51. }
  52.  
  53. static
  54. void display (void *vprim, putc_proc pp, void *cd)
  55. {
  56.   ScmPrimitive *prim = vprim;
  57.  
  58.   putc_string ("#<Primitive ", pp, cd);
  59.   putc_string (prim->name, pp, cd);
  60.   (* pp) ('>', cd);
  61. }
  62.  
  63. static
  64. void init_module (void)
  65. {
  66.   unsigned i;
  67.   for (i = 0; i < DIM (primitive_array); i++)
  68.     primitive_array[i].seq_num = i;
  69. }
  70.  
  71. static
  72. struct scheme_od_extension ext = {
  73.   display, display,
  74.   NULL,    NULL,        /* must coincide to be equal */
  75. };
  76.  
  77. OD_VECTOR (ScmPrimitive_od_vector,
  78.   0,            /* these are fixed objects, there can be only one! */
  79.   NULL,
  80.   do_nothing_on_subs,
  81.   PRIMITIVE_IDENTIFIER,
  82.   dump, restore_init, NULL,
  83.   init_module,
  84.   NULL, NULL,
  85.   &ext
  86. );
  87.  
  88. void *GetScmPrimitive (unsigned long seq_num)
  89. {
  90.   return (void *) (seq_num < DIM (primitive_array)
  91.             ? primitive_array + seq_num
  92.             : NULL);
  93. }
  94.